home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / compmrk.com / EXPFILE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-27  |  2.3 KB  |  85 lines
  1. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V+}
  2. {$M 8192,0,655360}
  3. Program ExpFile;
  4. { This is a simple minded test program which uses COMPMARK to expand a file
  5.   created by COMPFILE.  This program is intended as part of a demonstration
  6.   of the objects in COMPMARK, not as a serious file compression program.
  7.   See the comments in COMPMARK for information on appropriate use of these
  8.   objects. }
  9. Uses CompMark, Dos, Crt;
  10. Const
  11.   BufferSize = 20000; { Output buffer size }
  12.   BufferPad = 5000;   { Input buffer is this much bigger than output buffer }
  13.   WriteMode = $11;    { Exclusive, Write access for output file }
  14. Var
  15.   OutBuffer : Pointer;
  16.   OutFile : File;
  17.   InFile : CompFileIn;
  18.   InName, OutName : String;
  19.  
  20. Procedure Initialize;
  21. Var
  22.   ch : Char;
  23.   OldMode : Byte;
  24. Begin
  25.   GetMem(OutBuffer, BufferSize);
  26.   If ParamCount > 0 Then InName := ParamStr(1) Else Begin
  27.     Write('Enter input file name: ');
  28.     ReadLn(InName);
  29.   End;
  30.   InFile.Init(InName, BufferSize + BufferPad);
  31.   If Not InFile.CompOpen Then Begin
  32.     WriteLn('Unable to open input file ', InName);
  33.     Halt(1);
  34.   End;
  35.   WriteLn('Length of original file was ', InFile.CompTotal, ' bytes');
  36.   If ParamCount > 1 Then OutName := ParamStr(2) Else Begin
  37.     Write('Enter output file name: ');
  38.     ReadLn(OutName);
  39.   End;
  40.   WriteLn('EXPFILE will expand ', InName, ' to ', OutName);
  41.   Write('OK? (Y/N): ');
  42.   ch := UpCase(ReadKey);
  43.   WriteLn(ch, ' ');
  44.   If ch <> 'Y' Then Begin
  45.     WriteLn('Program terminated');
  46.     Halt(1);
  47.   End;
  48.   {$I-}
  49.   OldMode := FileMode;
  50.   FileMode := WriteMode;
  51.   Assign(OutFile, OutName);
  52.   ReWrite(OutFile, 1);
  53.   FileMode := OldMode;
  54.   If IoResult <> 0 Then Begin
  55.     WriteLn('Unable to open output file ', OutName);
  56.     Halt(1);
  57.   End;
  58.   {$I+}
  59.   Write('Working');
  60. End;
  61.  
  62. Procedure WriteExpandedBuffer;
  63. Var
  64.   Len : Word;
  65. Begin
  66.   Len := InFile.RecLength;
  67.   If Len > BufferSize Then Begin
  68.     WriteLn('Record longer than buffer, expansion terminated');
  69.     WriteLn('Record: ', Len );
  70.     WriteLn('Buffer: ', BufferSize);
  71.     Halt(1);
  72.   End;
  73.   InFile.GetRecord(OutBuffer^, BufferSize);
  74.   BlockWrite(OutFile, OutBuffer^, Len);
  75.   Write('.');
  76. End;
  77.  
  78. Begin
  79.   Initialize;
  80.   While Not InFile.Eof Do WriteExpandedBuffer;
  81.   WriteLn;
  82.   InFile.Done;
  83.   Close(OutFile);
  84.   WriteLn(InName, ' expanded to ', OutName);
  85. End.